00100	FEXPR COMPL FILE ← BEGIN SCALAR Z;
00200		EVAL('OUTPUT . ('DSK!: . LIST (CAR FILE . 'LAP)))$
00300		EVAL('INPUT . ('DSK!: . FILE))$
00400		INC('T ,NIL)$
00500		OUTC(T,NIL)$
00600	LOOP:	Z ← ERRSET(READ())$
00700		IF ATOM Z THEN GO TO DONE$
00800		Z ← CAR Z$
00900		IF CAR Z EQ 'DE THEN
01000	BEGIN SCALAR PROG;
01100		PROG ← COMP(CADR Z,CADDR Z,CADDDR Z)$
01200		MAPC(FUNCTION(PRINT),PROG)$
01300		OUTC(NIL,NIL)$
01400		PRINT LIST(CADR Z,LENGTH PROG)$
01500		OUTC(T,NIL)$
01600	END
01700		ELSE PRINT Z$
01800		GO TO LOOP$
01900	DONE:	OUTC(NIL,T)$
02000		INC(NIL,T)$
02100		RETURN 'ENDCOMP END;
02200	
02300	COMP(FN,VARS,EXP) ←
02400		(LAMBDA VPR,N;
02500			APPEND(
02600				LIST LIST('LAP,FN,'SUBR ),
02700				MKPUSH(N,1),
02800				COMPEXP(EXP,-N,VPR),
02900				SUBSTACK N,
03000				'((POPJ P) NIL)))
03100		(PRUP(VARS,1),LENGTH VARS);
03200	
03300	SUBSTACK N ← IF N=0 THEN NIL
03400		ELSE LIST LIST('SUB ,'P ,LIST('C ,0,0,N,N));
03500	
03600	PRUP(VARS,N) ← IF NULL VARS THEN NIL
03700			ELSE (CAR VARS . N) . PRUP(CDR VARS,N+1);
03800	
03900	MKPUSH(N,M) ← IF N<M THEN NIL ELSE LIST('PUSH ,'P ,M).MKPUSH(N,M+1);
04000	
04100	COMPEXP(EXP,M,VPR) ←
04200		IF NULL EXP THEN '((MOVEI 1 0))
04300		ELSE IF EXP EQ 'T OR NUMBERP EXP THEN
04350			LIST LIST('MOVEI, 1, (LIST('QUOTE, EXP)))
04400		ELSE IF ATOM EXP THEN
04500			LIST LIST('MOVE ,1,M+CDR ASSOC(EXP,VPR),'P )
04600		ELSE IF CAR EXP EQ 'CAR THEN
04700			(IF ATOM CADR EXP THEN
04800				LIST LIST('HLRZ!@ ,1,
04900				  M+CDR ASSOC(CADR EXP,VPR),'P )
05000				ELSE APPEND(COMPEXP(CADR EXP,M,VPR),
05100				'((HLRZ!@ 1 1))))
05200		ELSE IF CAR EXP EQ 'CDR THEN
05300			(IF ATOM CADR EXP THEN
05400				LIST LIST('HRRZ!@ ,1,
05500				  M+CDR ASSOC(CADR EXP,VPR),'P )
05600				ELSE APPEND(COMPEXP(CADR EXP,M,VPR),
05700				'((HRRZ!@ 1 1))))
05800		ELSE IF CAR EXP EQ 'AND OR CAR EXP EQ 'OR OR
05900				CAR EXP EQ 'NOT OR CAR EXP EQ 'EQ THEN
06000			(LAMBDA L1,L2; APPEND(
06100					COMBOOL(EXP,M,L1,NIL,VPR),
06200				LIST('(MOVEI 1 (QUOTE T)),LIST('JRST ,0,L2),
06300				L1,'(MOVEI 1 0),L2)))
06400			(GENSYM1(),GENSYM1())
06500		ELSE IF CAR EXP EQ 'COND THEN
06600			COMCOND(CDR EXP,M,GENSYM1(),VPR)
06700		ELSE IF CAR EXP EQ 'QUOTE THEN LIST LIST('MOVEI,1,EXP)
06800		ELSE IF ATOM CAR EXP THEN
06900			APPEND(COMPLISA(CDR EXP,M,VPR),
07000				LIST LIST('CALL ,LENGTH CDR EXP,
07100					LIST('E ,CAR EXP)))
07200		ELSE IF CAAR EXP EQ 'LAMBDA THEN
07300			(LAMBDA N; APPEND(STACKUP(CDR EXP,M,VPR),
07400				COMPEXP(CADDAR EXP,M-N,
07500				APPEND(PRUP(CADAR EXP,1-M),VPR)),
07600				SUBSTACK N))
07700			LENGTH CDR EXP;
07800	
07900	STACKUP(U,M,VPR) ← IF NULL U THEN NIL
08000			ELSE APPEND(COMPEXP(CAR U,M,VPR),
08100				'((PUSH P 1)),
08200					STACKUP(CDR U,M-1,VPR));
08300	
08400	
08500	CCCHAIN EXP ← (CAR EXP EQ 'CAR OR CAR EXP EQ 'CDR) AND
08600			(ATOM CADR EXP OR CCCHAIN CADR EXP);
08700	
08800	COMPC(EXP,N2,M,VPR) ←
08900		IF ATOM EXP THEN ERROR 'COMPC 
09000		ELSE IF CAR EXP EQ 'CAR THEN
09100			(IF ATOM CADR EXP THEN
09200			LIST LIST('HLRZ!@ ,N2,M+CDR ASSOC(CADR EXP,VPR),'P )
09300			ELSE LIST('HLRZ!@ ,N2,N2).COMPC(CADR EXP,N2,M,VPR))
09400		ELSE IF ATOM CADR EXP THEN
09500			LIST LIST('HRRZ!@ ,N2,M+CDR ASSOC(CADR EXP,VPR),'P )
09600			ELSE LIST('HRRZ!@ ,N2,N2).COMPC(CADR EXP,N2,M,VPR);
09700	
09800	COMCOND(U,M,L,VPR) ←
09900		IF NULL U THEN LIST L
10000		ELSE IF NOT ATOM CAAR U AND CAAAR U EQ 'NULL AND NULL CADAR U THEN
10100			APPEND(COMPEXP(CADAAR U,M,VPR),
10200				LIST LIST('JUMPE ,1,L),
10300				COMCOND(CDR U,M,L,VPR))
10400		ELSE IF CAAR U EQ 'T THEN
10500			APPEND( COMPEXP(CADAR U,M,VPR),LIST L)
10600		ELSE (LAMBDA L1; APPEND(
10700			COMBOOL(CAAR U,M,L1,NIL,VPR),
10800			COMPEXP(CADAR U,M,VPR),
10900			LIST(LIST('JRST ,0,L),L1),
11000			COMCOND(CDR U,M,L,VPR)))
11100		GENSYM1();
11200	
11300	
11400	COMPLISA(U,M,VPR) ←
11500		(LAMBDA Z; APPEND(
11600			COMPLIS(Z,M,1,VPR),
11700			LOADAC(Z,1-CCOUNT Z,1,M-CCOUNT Z,VPR),
11800			SUBSTACK CCOUNT Z))
11900		CLASSIFY U;
12000	
12100	CCOUNT Z ← IF NULL Z THEN 0 ELSE IF CAAR Z = 4 THEN 1+CCOUNT CDR Z
12200		ELSE CCOUNT CDR Z;
12300	
12400	LOADAC(Z,M2,N2,M,VPR) ←
12500		IF NULL Z THEN NIL
12600		ELSE IF CAAR Z = 1 THEN
12700			LIST('MOVE ,N2,M+CDR ASSOC(CDAR Z,VPR),'P )
12800				.LOADAC(CDR Z,M2,N2+1,M,VPR)
12830		ELSE IF CAAR Z = 0 THEN
12860			LIST('MOVEI, N2, (LIST('QUOTE, CDAR Z)))
12890				.LOADAC(CDR Z, M2, N2+1, M, VPR)
12900		ELSE IF CAAR Z = 2 THEN
13000			LIST('MOVEI ,N2,CDAR Z)
13100				.LOADAC(CDR Z,M2,N2+1,M,VPR)
13200		ELSE IF CAAR Z =3 THEN
13300			APPEND(REVERSE COMPC(CDAR Z,N2,M,VPR),
13400				LOADAC(CDR Z,M2,N2+1,M,VPR))
13500		ELSE IF CAAR Z = 5 THEN LOADAC(CDR Z, 1, N2+1, M, VPR)
13600		ELSE LIST('MOVE ,N2,M2,'P ).
13700				LOADAC(CDR Z,M2+1,N2+1,M,VPR);
13800	
13900	COMPLIS(Z,M,K,VPR) ←
14000		IF NULL Z THEN NIL
14100		ELSE IF CAAR Z = 4 THEN APPEND(
14200				COMPEXP(CDAR Z,M,VPR),
14300				'((PUSH P 1)),
14400				COMPLIS(CDR Z,M-1,K+1,VPR))
14500		ELSE IF CAAR Z = 5 THEN APPEND(
14600				COMPEXP(CDAR Z,M,VPR),
14700				IF K=1 THEN NIL 
14800				ELSE LIST LIST('MOVE ,K,1))
14900		ELSE COMPLIS(CDR Z,M,K+1,VPR);
15000	
15100	CLASSIFY U ← CLASS2(CLASS1(U,NIL),NIL,T);
15200	
15300	CLASS1(U,V) ← IF NULL U THEN V
15400		ELSE IF ATOM CAR U THEN
15430			(IF CAR U = 'NIL OR CAR U = 'T OR NUMBERP CAR U THEN
15460				CLASS1(CDR U, (0 . CAR U).V)
15490				ELSE CLASS1(CDR U, (1 . CAR U).V))
15500		ELSE IF CAAR U = 'QUOTE THEN CLASS1(CDR U,(2 . CAR U).V)
15600		ELSE IF CCCHAIN CAR U THEN CLASS1(CDR U,(3 . CAR U).V)
15700		ELSE CLASS1(CDR U,(4 . CAR U).V);
15800	
15900	CLASS2(U,V,FLG) ← IF NULL U THEN V
16000			ELSE IF FLG AND (CAAR U = 4) THEN
16100					CLASS2(CDR U,(5 . CDAR U).V,NIL)
16200			ELSE CLASS2(CDR U,CAR U . V,FLG);
16300	
16400	MKJRST L ← LIST LIST('JRST ,0,L);
16500	
16600	COMBOOL(P,M,L,FLG,VPR) ←
16700		IF P EQ 'T THEN (IF FLG THEN MKJRST L ELSE NIL)
16720		ELSE IF ATOM P THEN APPEND(
16740					COMPEXP(P, M, VPR),
16760					LIST LIST (IF FLG THEN 'JUMPN
16780							ELSE 'JUMPE ,1,L))
16800		ELSE IF CAR P EQ 'EQ THEN APPEND(
16900				COMPLISA(CDR P,M,VPR),
17000				IF FLG THEN '((CAMN 1 2)) ELSE '((CAME 1 2)),
17100				MKJRST L)
17200		ELSE IF CAR P EQ 'AND THEN
17300			(IF NOT FLG THEN COMPANDOR(CDR P,M,L,NIL,VPR)
17400			ELSE (LAMBDA L1; APPEND(
17500				COMPANDOR1(CDR P,M,L1,L,NIL,VPR),
17600					LIST L1))
17700				GENSYM1())
17800		ELSE IF CAR P EQ 'OR THEN
17900			(IF FLG THEN COMPANDOR(CDR P,M,L,T,VPR)
18000			ELSE (LAMBDA L1; APPEND(
18100					COMPANDOR1(CDR P,M,L1,L,T,VPR),
18200					LIST L1))
18300				GENSYM1())
18400		ELSE IF CAR P EQ 'NOT THEN
18500			COMBOOL(CADR P,M,L,NOT FLG,VPR)
18600		ELSE IF CAR P EQ 'NULL THEN APPEND(
18700					COMPEXP(CADR P,M,VPR),
18800					LIST LIST(IF FLG THEN 'JUMPE
18900							ELSE 'JUMPN ,1,L))
19000		ELSE                    APPEND(
19100					COMPEXP(P,M,VPR),
19200					LIST LIST(IF FLG THEN 'JUMPN
19300							ELSE 'JUMPE ,1,L));
19400	
19500	COMPANDOR(U,M,L,FLG,VPR) ← IF NULL U THEN NIL
19600		ELSE APPEND(COMBOOL(CAR U,M,L,FLG,VPR),
19700				COMPANDOR(CDR U,M,L,FLG,VPR));
19800	
19900	COMPANDOR1(U,M,L,L2,FLG,VPR) ← IF NULL U THEN MKJRST L2
20000		ELSE IF NULL CDR U THEN COMBOOL(CAR U,M,L2,NOT FLG,VPR)
20100		ELSE APPEND(COMBOOL(CAR U,M,L,FLG,VPR),
20200				COMPANDOR1(CDR U,M,L,L2,FLG,VPR));
20300	
20400	
20600	
20700	
20800	GENSYM1() ← LIST('LABEL,GENSYM());
20900	
21000	FLAT(U,S) ← IF ATOM CAR U THEN U.S ELSE FLAT(CAR U,FLAT(CDR U,S));